home *** CD-ROM | disk | FTP | other *** search
- #!/usr/bin/perl
-
- #
- # Yo yo, this be da socketNinja.
- # Alpha-2.0 release
- # Distribute and get a visit from tireIronNinja
- #
- # -spoon
-
- # any place you can do a [ip:]port
- # you can also use 0 or 1 for ip
- # and 0 == 127.0.0.1 and 1 = 0.0.0.0
-
- my $recvLength = 4096; # Herm, here for some testing reasons.
-
-
- ##### #####
- ## Main ##
- ##### #####
- use strict;
- use Getopt::Std;
- my %opts;
- getopts('hl:d:', \%opts); # I plan on adding more options someday
-
- if($opts{'h'}) {
- usage();
- exit(0);
- }
-
- my $ninja;
- if($opts{'d'}) {
- $ninja = sN::listenNinja->new($opts{'d'});
- }
- else {
- $ninja = sN::consoleNinja->new;
- }
-
- if($opts{'l'}) {
- $ninja->createListener($opts{'l'});
- }
-
- $ninja->listenLoop;
-
-
- sub usage {
- print q{
- socketNinja alpha-2.0
- -d [ip:]port : Start sN in listener mode, no console
- -l [ip:]port : create a listener on this port
- };
- }
-
- ##### #####
- ## SocketNinja ##
- ##### #####
- package sN::socketNinja;
- use strict;
- use IO::Select;
-
- sub new {
- my $self = bless(
- {
- __PACKAGE__.'selector' => IO::Select->new,
- __PACKAGE__.'listeners' => [ ],
- __PACKAGE__.'config' => { },
- }, shift);
- $self->_config($self->readConfig);
- return($self);
- }
-
- sub _selector {
- my $self = shift;
- $self->{__PACKAGE__.'selector'} = shift if(@_);
- return($self->{__PACKAGE__.'selector'});
- }
- sub _listeners {
- my $self = shift;
- $self->{__PACKAGE__.'listeners'} = shift if(@_);
- return($self->{__PACKAGE__.'listeners'});
- }
- sub _config {
- my $self = shift;
- $self->{__PACKAGE__.'config'} = shift if(@_);
- return($self->{__PACKAGE__.'config'});
- }
-
-
- sub getListeners {
- my $self = shift;
- return(@{$self->_listeners});
- }
- sub addListener {
- my $self = shift;
- foreach (@_) {
- push(@{$self->_listeners}, $_);
- $_->setName($self->lSock($_));
- $_->setParent($self);
- $self->_selector->add($_);
- }
- }
- sub connectServerListener {
- my $self = shift;
- my $i = 0;
- foreach ($self->getListeners) {
- return($i) if($_->getName eq 'connectServers');
- $i++;
- }
- return(-1);
- }
- sub connectClientAttachedListener {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $i = 0;
- #fixme
- # print "- $listenerIndex - $serverIndex -\n";
- foreach ($self->_listeners->[$listenerIndex]->_servers->[$serverIndex]->getAttachedListeners) { #fixme
- return($i) if($_->getName eq 'connectClients');
- $i++;
- }
- return(-1);
- }
-
- sub removeListener {
- my $self = shift;
- my $listener = shift;
- for(my $i = 0; $i < @{$self->_listeners}; $i++) {
- splice(@{$self->_listeners}, $i, 1) if($self->_listeners->[$i] == $listener);
- }
- $self->_selector->remove($listener);
- }
-
- sub getConfig {
- my $self = shift;
- return(%{$self->_config});
- }
-
- sub createListener {
- my $self = shift;
- my ($addr, $port) = $self->parseConn(shift, 1); # default to public
- my $listener = sN::listener->new(
- LocalPort => $port,
- LocalAddr => $addr,
- Proto => 'tcp',
- ReuseAddr => 1,
- Listen => 5,
- );
- if(!$listener) {
- $self->message('Failed to create listener: ' . $!);
- return;
- }
- $self->addListener($listener);
- $self->message('Created listener ' . $listener->getName);
- }
-
- sub addAttachedListener {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $listenSock = shift;
- $listenSock->setName($self->lSock($listenSock));
- $self->_listeners->[$listenerIndex]->_servers->[$serverIndex]->addAttachedListener($listenSock); #fixme
- $self->_selector->add($listenSock);
- }
-
- sub createRandomAttachedListener {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- $self->addAttachedListener($listenerIndex, $serverIndex, $self->makeRandomAttachedListener);
- }
- sub createCustomAttachedListener {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $conn = shift;
- my $attachedListener = $self->makeCustomAttachedListener($self->parseConn($conn));
- return if(!$attachedListener);
-
- $self->addAttachedListener($listenerIndex, $serverIndex, $attachedListener);
- }
-
- sub makeRandomAttachedListener {
- my $self = shift;
- my $listenPort;
- my $listenSock;
- do {
- $listenPort = int(rand(10000)) + 2000;
- $listenSock = sN::attachedListener->new(
- LocalAddr => '127.0.0.1',
- LocalPort => $listenPort,
- Proto => 'tcp',
- ReuseAddr => 1,
- Listen => 5,
- );
- if(!$listenSock) {
- $self->debug("Socket no good: " . $! . ", trying again");
- }
- else {
- $self->message('New listener (' . $listenSock->fileno . ") bound to 127.0.0.1:$listenPort");
- }
- } while(!$listenSock);
-
- return($listenSock);
- }
- sub makeCustomAttachedListener {
- my $self = shift;
- my $addr = shift;
- my $port = shift;
- my $listenSock;
-
- $listenSock = sN::attachedListener->new(
- LocalAddr => $addr,
- LocalPort => $port,
- Proto => 'tcp',
- ReuseAddr => 1,
- Listen => 5,
- );
- if(!$listenSock) {
- $self->message('Failed to create attachedListener: ' . $!);
- return;
- }
- else {
- $self->message('New listener (' . $listenSock->fileno . ") bound to $addr:$port");
- }
-
- return($listenSock);
- }
-
- sub addConnectServer {
- my $self = shift;
- my $connectServer = shift;
- my $listener;
- if($self->connectServerListener < 0) {
- $listener = sN::listener->new;
- $self->addListener($listener);
- $listener->setName('connectServers');
- }
- else {
- $listener = $self->_listeners->[$self->connectServerListener];
- }
- $connectServer->setName($self->pSock($connectServer));
- $listener->addServer($connectServer);
- $self->_selector->add($connectServer);
- $self->message('Added connectServer ' . $connectServer->getName);
- }
-
- sub createConnectServer {
- my $self = shift;
- my $addr = shift;
- my $port = shift;
-
- my $server = sN::server->new(
- PeerAddr => $addr,
- PeerPort => $port,
- Proto => 'tcp',
- Timeout => 10, # This is important, socketNinja will hang until connection is established
- );
- if(!$server) {
- $self->message('Failed to create connectServer: ' . $!);
- return;
- }
- $self->addConnectServer($server);
- }
-
- sub addConnectClient {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $connectClient = shift;
- my $attachedListener;
- my $ccal = $self->connectClientAttachedListener($listenerIndex, $serverIndex);
- if($ccal < 0) {
- $attachedListener = sN::attachedListener->new;
- $self->addAttachedListener($listenerIndex, $serverIndex, $attachedListener);
- $attachedListener->setName('connectClients');
- }
- else {
- $attachedListener = $self->_listeners->[$listenerIndex]->_servers->[$serverIndex]->_attachedListeners->[$ccal]; #fixme
- }
- $connectClient->setName($self->pSock($connectClient));
- $attachedListener->addClient($connectClient);
- $self->_selector->add($connectClient);
- $self->message('Added connectClient ' . $connectClient->getName);
- }
-
- sub createConnectClient {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $addr = shift;
- my $port = shift;
-
- my $client = sN::client->new(
- PeerAddr => $addr,
- PeerPort => $port,
- Proto => 'tcp',
- Timeout => 10, # This is important, socketNinja will hang until connection is established
- );
- if(!$client) {
- $self->message('Failed to create connectClient: ' . $!);
- return;
- }
- $self->addConnectClient($listenerIndex, $serverIndex, $client);
- }
-
-
-
- sub listenLoop {
- my $self = shift;
- $self->message("socketNinja started.");
- while(my @ready = $self->_selector->can_read) {
- foreach (@ready) {
- $self->handleSocket($_);
- }
- }
- }
-
- sub handleSocket {
- my $self = shift;
- my $socket = shift;
- if($socket->isListener) {
- $self->handleListener($socket);
- }
- elsif($socket->isAttachedListener) {
- $self->handleAttachedListener($socket);
- }
- elsif($socket->isServer) {
- $self->handleServer($socket);
- }
- elsif($socket->isClient) {
- $self->handleClient($socket);
- }
- }
-
- sub handleListener {
- my $self = shift;
- my $socket = shift;
- my $newSock = $socket->accept('sN::server');
- $newSock->setName($self->pSock($newSock));
- $socket->addServer($newSock);
- $self->_selector->add($newSock);
- $self->message('Added server ' . $newSock->getName . ' to listener ' . $socket->getName);
- }
-
- sub handleAttachedListener {
- my $self = shift;
- my $socket = shift;
- my $newSock = $socket->accept('sN::client');
- $newSock->setName($self->pSock($newSock));
- $socket->addClient($newSock);
- $self->_selector->add($newSock);
- $self->message('Added client ' . $newSock->getName . ' to attachedListener ' . $socket->getName);
- }
-
- sub handleServer {
- my $self = shift;
- my $socket = shift;
- my $data;
- $socket->recv($data, $recvLength);
- if(!length($data)) {
- $self->destroyConnection($socket);
- $self->message('Server connection ' . $socket->getName . ' dead');
- }
- else {
- $socket->serverWrite($data);
- }
- }
-
- sub handleClient {
- my $self = shift;
- my $socket = shift;
- my $data;
- $socket->recv($data, $recvLength);
- if(!length($data)) {
- $self->destroyConnection($socket);
-
- $self->message('Client connection ' . $socket->getName . ' dead');
- }
- else {
- $socket->getParent->getParent->clientWrite($socket, $data);
- }
- }
-
-
- sub getServer {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $listener = $self->_listeners->[$listenerIndex];
- return if(!$listener);
- return($listener->_servers->[$serverIndex]);
- }
-
- sub getAttachedListener {
- my $self = shift;
- my $listenerIndex = shift;
- my $serverIndex = shift;
- my $attachedListenerIndex = shift;
-
- my $listener = $self->_listeners->[$listenerIndex];
- return if(!$listener);
- my $server = $listener->_servers->[$serverIndex];
- return if(!$server);
- return($server->_attachedListeners->[$attachedListenerIndex]);
- }
-
-
- sub configFilename {
- use File::Spec::Functions;
- use File::Basename;
-
- my $basedir = dirname(File::Spec::Functions::rel2abs($0));
- $basedir .= $^O eq 'WIN32' ? '\\' : '/';
- return($basedir . '.socketNinja');
- }
-
- sub readConfig {
- my $self = shift;
- my $filename = $self->configFilename;
-
- my %defaults = (
- 'program' => 'Eterm -e nc -v [ip] [port]',
- 'program-w' => 'c:\\putty.exe -raw -P [port] [ip]',
- 'defaultPort' => '12345',
- 'superDebug' => '0',
- );
-
- if(!-e $filename) {
- return(\%defaults)
- }
-
- my %vars;
- open(INFILE, "<$filename") or return(\%defaults);
- while(<INFILE>) {
- chomp;
- /(.*?), (.*)/;
- $vars{$1} = $2;
- }
- close(INFILE);
- return(\%vars);
- }
-
- sub writeConfig {
- my $self = shift;
- my %vars = @_;
- my $filename = $self->configFilename;
- open(OUTFILE, ">$filename") or return;
- foreach (keys(%vars)) {
- print OUTFILE "$_, $vars{$_}\n";
- }
- close(OUTFILE);
- }
-
- sub destroyConnection {
- my $self = shift;
- my $socket = shift;
- my @toDestroy = $socket->getSockets;
- foreach (@toDestroy) {
- $self->_selector->remove($_);
- $_->destroySelf;
- }
- }
-
- sub parseConn {
- my $self = shift;
- my ($port, $addr) = reverse(split(':', shift));
- # defaults to private (127.0.0.1)
- # 1 to default to public (0.0.0.0)
- $addr = @_ ? shift : 0 if(!defined($addr)); # if 1, default to public
-
-
- $addr = '127.0.0.1' if($addr eq 0);
- $addr = '0.0.0.0' if($addr eq 1);
-
- return($addr, $port);
- }
- sub pSock {
- my $self = shift;
- my $socket = shift;
- return($socket->peerhost . ':' . $socket->peerport);
- }
- sub lSock {
- my $self = shift;
- my $socket = shift;
- return($socket->sockhost . ':' . $socket->sockport);
- }
-
-
-
- ##### #####
- ## CommandNinja ##
- ##### #####
- package sN::commandNinja;
- use strict;
- use base 'sN::socketNinja';
-
- sub handleData {
- my $self = shift;
- my $data = shift;
- my($command, @args) = split(' ', $data);
- #fixme $self->cprint("Got data command: $command with args(@args)\n") if($main::superDebug);
- $command = $self->findCommand($command);
- if(!$command) {
- $self->message("Invalid command.\n");
- next;
- }
- if($self->getCommands->{$command}[2] > @args) {
- $self->launchCommand('help', $command);
- next;
- }
- $self->launchCommand($command, @args);
- }
-
-
- sub getCommands {
- my $self = shift;
- return(
- {
- # HashKey/Long Name, [Short Name, Command, Least number of arguments],
- 'help', ['?', 'Shows the help menu', 0],
- 'listen', ['li', 'Create a listener', 1, '<d | [ip:]port>'],
- 'list', ['l', 'List connection tree', 0],
- 'addRandom', ['ar', 'Create a randomAttachedListener', 1, '[listener #] <server #>'],
- 'addCustom', ['ac', 'Create a customAttachedListener', 2, '[listener #] <server #> [ip:]<port>'],
- 'addServer', ['as', 'Create a connectServer', 2, '<ip> <port>'],
- 'addClient', ['acl', 'Create a connectClient', 2, '[listener #] [server #] <ip> <port>'],
- 'close', ['c', 'Close a connection', 1, '<listener #> [server #] [attachedListener #] [client #]'],
- 'writeConfig', ['wc', 'Write config settings out to file', 0, ''],
- 'showConfig', ['sc', 'Print config settings', 0, ''],
- 'setConfig', ['set', 'Set a config value', 2, '<key> <value>'],
- 'runApp', ['run', 'Launch program for attachedListener', 1, '[listener #] [server #] <attachedListener #> [altProg]'],
- 'quit', ['q', 'Quit', 0],
- }
- );
- }
-
- sub findCommand {
- my $self = shift;
- my $command = shift;
- foreach (keys(%{$self->getCommands})) {
- return($_) if($_ eq $command || $self->getCommands->{$_}[0] eq $command);
- }
- }
- sub launchCommand {
- my $self = shift;
- my $command = shift;
- my @args = @_;
- no strict 'refs'; # Bah
- $command = 'command_' . $command;
- $self->cprint("\n");
- $self->$command(@args);
- $self->cprint("\n");
- }
-
- ###
- # Commands
- ###
- sub command_list {
- my $self = shift;
- my $col = sN::colprint->new(1);
- $self->cprint("Connection Tree\n");
- $col->addRow('Listener', 'Server', 'AttachedListener', 'Client');
- $col->addRow('__hr__', '__hr__', '__hr__', '__hr__');
-
-
- # When I am less tired I will do this a better way
- my $i = 0;
- foreach my $listener ($self->getListeners) {
- $col->addRow("$i: ".$listener->getName);
- my $j = 0;
- foreach my $server ($listener->getServers) {
- $col->addRow('', "$j: ".$server->getName);
- my $k = 0;
- foreach my $attachedListener ($server->getAttachedListeners) {
- $col->addRow('', '', "$k: ".$attachedListener->getName);
- my $l = 0;
- foreach my $client ($attachedListener->getClients) {
- $col->addRow('', '', '', "$l: ".$client->getName);
- $l++;
- }
- $k++;
- }
- $j++;
- }
- $i++;
- }
- $self->cprint($col->getOutput);
- }
-
- sub command_addRandom {
- my $self = shift;
- my $serverIndex = pop;
- my $listenerIndex = @_ ? pop : 0; # If there is only 1 argument, we presume listenerIndex = 0
-
- if(!$self->getServer($listenerIndex, $serverIndex)) {
- $self->cprint("Invalid server.\n");
- return;
- }
- $self->createRandomAttachedListener($listenerIndex, $serverIndex);
- }
-
- sub command_addCustom {
- my $self = shift;
- my $conn = pop;
- my $serverIndex = pop;
- my $listenerIndex = pop || 0;
-
- if(!$self->getServer($listenerIndex, $serverIndex)) {
- $self->cprint("Invalid server.\n");
- return;
- }
-
- $self->createCustomAttachedListener($listenerIndex, $serverIndex, $conn);
- }
-
- sub command_help {
- my $self = shift;
- my $command = shift;
- my $col = sN::colprint->new(1);
- if($command) {
- $command = $self->findCommand($command);
- if(!$command) {
- $self->cprint("help: command not found.\n");
- return;
- }
- my $info = $self->getCommands->{$command};
- $col->addRow('command:', $command);
- $col->addRow('shortcut:', $info->[0]);
- $col->addRow('Description:', $info->[1]);
- $col->addRow('Usage:', $info->[3]) if($info->[3]);
- $self->cprint($col->getOutput);
- }
- else {
- $self->cprint("Commands:\n");
- $col->addRow('cmd', 'shortcut', 'description');
- $col->addRow('__hr__', '__hr__', '__hr__');
- foreach (sort(keys(%{$self->getCommands}))) {
- my $info = $self->getCommands->{$_};
- $col->addRow("$_:", $info->[0], $info->[1]);
- }
- $self->cprint($col->getOutput);
- }
- }
- sub command_quit {
- my $self = shift;
- exit(0);
- }
- sub command_listen {
- my $self = shift;
- my $conn = shift;
-
- $conn = $self->_config->{'defaultPort'} if($conn eq 'd');
- $self->createListener($conn);
-
- }
- sub command_close {
- my $self = shift;
- my $listenerIndex = shift;
- my $listener = $self->_listeners->[$listenerIndex];
- if(!$listener) {
- $self->message('Invalid listener.');
- return;
- }
- if(!@_) {
- $self->destroyConnection($listener);
- return;
- }
- my $serverIndex = shift;
- my $server = $listener->_servers->[$serverIndex];
- if(!$server) {
- $self->message('Invalid server.');
- return;
- }
- if(!@_) {
- $self->destroyConnection($server);
- return;
- }
- my $attachedListenerIndex = shift;
- my $attachedListener = $server->_attachedListeners->[$attachedListenerIndex];
- if(!$attachedListener) {
- $self->message('Invalid attachedListener.');
- return;
- }
- if(!@_) {
- $self->destroyConnection($attachedListener);
- return;
- }
- my $clientIndex = shift;
- my $client = $attachedListener->_clients->[$clientIndex];
- if(!$client) {
- $self->message('Invalid client.');
- return;
- }
- $self->destroyConnection($client);
- }
-
- sub command_writeConfig {
- my $self = shift;
- $self->writeConfig($self->getConfig);
- $self->cprint("Wrote config.\n");
- }
- sub command_showConfig {
- my $self = shift;
- my %config = $self->getConfig;
- my $col = sN::colprint->new(1);
- $self->cprint("Config settings:\n");
- $col->addRow('Key', 'Value');
- $col->addRow('__hr__', '__hr__');
- foreach (sort(keys(%config))) {
- $col->addRow("$_", $config{$_});
- }
- $self->cprint($col->getOutput);
- }
- sub command_setConfig {
- my $self = shift;
- my $key = shift;
- my $value = join(' ', @_);
- $self->cprint("$key -> $value\n");
- $self->_config->{$key} = $value;
- }
- sub command_runApp {
- my $self = shift;
-
- #fixme I'm still undecided on the best way of doing this
- my $altProg = pop if(@_ >= 4);
- my $attachedListenerIndex = pop;
- my $serverIndex = pop || 0;
- my $listenerIndex = pop || 0;
-
- $altProg = '-'.$altProg if(defined($altProg));
- my $program = $self->_config->{'program'.$altProg}; #fixme
- if(!defined($program)) {
- $self->cprint("No program defined.\n");
- return;
- }
- my $attachedListener = $self->getAttachedListener($listenerIndex, $serverIndex, $attachedListenerIndex);
- if(!$attachedListener) {
- $self->cprint("Invalid attachedListener.\n");
- return;
- }
-
- $program =~ s/\[ip\]/$attachedListener->sockhost/ge;
- $program =~ s/\[port\]/$attachedListener->sockport/ge;
- $self->cprint("Running: $program\n");
- if(!fork()) {
- exec("$program");
- }
- }
- sub command_addServer {
- my $self = shift;
- my $addr = shift;
- my $port = shift;
- $self->createConnectServer($addr, $port);
- }
- sub command_addClient {
- my $self = shift;
- my $port = pop;
- my $addr = pop;
- my $serverIndex = @_ ? pop : 0;
- my $listenIndex = @_ ? pop : 0;
-
- $self->createConnectClient($listenIndex, $serverIndex, $addr, $port);
- }
-
-
- ##### #####
- ## ConsoleNinja ##
- ##### #####
- package sN::consoleNinja;
- use strict;
- use base 'sN::commandNinja';
-
- sub new {
- my $class = shift;
- my $self = $class->SUPER::new;
- my $stdin = IO::Handle->new_from_fd(0, '<');
- $self->{__PACKAGE__.'stdin'} = $stdin;
- $self->_selector->add($stdin);
- return($self);
- }
-
- sub _stdin {
- my $self = shift;
- $self->{__PACKAGE__.'stdin'} = shift if(@_);
- return($self->{__PACKAGE__.'stdin'});
- }
-
- sub handleSocket {
- my $self = shift;
- my $socket = shift;
- if($socket == $self->_stdin) {
- $self->handleStdin($socket);
- }
- else {
- $self->SUPER::handleSocket($socket);
- }
- }
-
- sub handleStdin {
- my $self = shift;
- my $socket = shift;
- my $data = <$socket>;
- $self->handleData($data);
- }
-
- sub message {
- my $self = shift;
- print "* ", shift, "\n";
- }
-
- sub cprint {
- my $self = shift;
- print shift;
- }
-
-
- ##### #####
- ## ListenNinja ##
- ##### #####
- package sN::listenNinja;
- use strict;
- use base 'sN::commandNinja';
-
- #
- # This should all be rewritten, it is ugly
- # It should basically be a server (the class)
- #
-
- sub new {
- my $class = shift;
- my ($addr, $port) = $class->parseConn(shift); # default to private
-
- my $listener = sN::listener->new(
- LocalPort => $port,
- LocalAddr => $addr,
- Proto => 'tcp',
- ReuseAddr => 1,
- Listen => 5,
- );
- if(!$listener) {
- print STDERR "Could not listen: $!\n";
- exit(1);
- }
-
- my $self = $class->SUPER::new;
-
- $self->{__PACKAGE__.'listener'} = $listener;
- $self->{__PACKAGE__.'clients'} = [],
- $self->{__PACKAGE__.'active'} = '',
- $self->_selector->add($listener);
- return($self);
- }
-
- sub _listener {
- my $self = shift;
- $self->{__PACKAGE__.'listener'} = shift if(@_);
- return($self->{__PACKAGE__.'listener'});
- }
- sub _clients {
- my $self = shift;
- $self->{__PACKAGE__.'clients'} = shift if(@_);
- return($self->{__PACKAGE__.'clients'});
- }
- sub _active {
- my $self = shift;
- $self->{__PACKAGE__.'active'} = shift if(@_);
- return($self->{__PACKAGE__.'active'});
- }
-
- sub getClients {
- my $self = shift;
- return(@{$self->_clients});
- }
-
- sub addClient {
- my $self = shift;
- push(@{$self->_clients}, @_);
- }
-
- sub removeClient {
- my $self = shift;
- my $client = shift;
- for(my $i = 0; $i < @{$self->_clients}; $i++) {
- splice(@{$self->_clients}, $i, 1) if($self->_clients->[$i] == $client);
- }
- $self->_selector->remove($client);
- }
-
-
- sub isClient {
- my $self = shift;
- my $socket = shift;
- return(grep {$_ == $socket} $self->getClients);
- }
-
- sub handleSocket {
- my $self = shift;
- my $socket = shift;
- if($socket == $self->_listener) {
- $self->handleListenListener($socket);
- }
- elsif($self->isClient($socket)) {
- $self->handleListenClient($socket);
- }
- else {
- $self->SUPER::handleSocket($socket);
- }
- }
-
- sub handleListenListener {
- my $self = shift;
- my $socket = shift;
- my $newSock = $socket->accept;
- $self->addClient($newSock);
- $self->_selector->add($newSock);
- }
-
- sub handleListenClient {
- my $self = shift;
- my $socket = shift;
-
- my $data;
- $socket->recv($data, $recvLength);
-
- if(!length($data)) {
- $self->removeClient($socket);
- return;
- }
-
- $self->_active($socket);
- $self->handleData($data);
- }
-
- sub cprint {
- my $self = shift;
- $self->_active->send(shift) if($self->_active);
- }
-
- sub message {
- my $self = shift;
- my $data = shift;
- foreach ($self->getClients) {
- $_->send("* $data\n");
- }
- }
-
-
- ##### #####
- ## SocketBase ##
- ##### #####
- package sN::socketBase;
- use strict;
- use base 'IO::Socket::INET';
-
- #sub new {
- # my $className = shift;
- # my $socket = shift;
- # my $self = bless($socket, $className);
- # return($self);
- #}
-
- sub new {
- my $class = shift;
- my $glob = $class->SUPER::new(@_);
- return if(!$glob);
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'name'} = '';
- $self->{__PACKAGE__.'parent'} = '';
- return($glob);
- }
-
- sub _name {
- my $glob = shift;
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'name'} = shift if(@_);
- return($self->{__PACKAGE__.'name'});
- }
- sub _parent {
- my $glob = shift;
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'parent'} = shift if(@_);
- return($self->{__PACKAGE__.'parent'});
- }
-
- sub getName {
- my $self = shift;
- return($self->_name);
- }
- sub getParent {
- my $self = shift;
- return($self->_parent);
- }
- sub setName {
- my $self = shift;
- return($self->_name(shift));
- }
- sub setParent {
- my $self = shift;
- return($self->_parent(shift));
- }
-
- sub getSockets {
- my $self = shift;
- return($self);
- }
-
- sub destroySelf {
- my $self = shift;
- $self->shutdown(2);
- }
-
- sub isListener {
- return(0);
- }
-
- sub isServer {
- return(0);
- }
-
- sub isAttachedListener {
- return(0);
- }
-
- sub isClient {
- return(0);
- }
-
- ##### #####
- ## listener ##
- ##### #####
- package sN::listener;
- use strict;
- use base 'sN::socketBase';
-
- sub new {
- my $class = shift;
- my $glob = $class->SUPER::new(@_);
- return if(!$glob);
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'servers'} = [];
- return($glob);
- }
-
- sub _servers {
- my $glob = shift;
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'servers'} = shift if(@_);
- return($self->{__PACKAGE__.'servers'});
- }
-
- sub getServers {
- my $self = shift;
- return(@{$self->_servers});
- }
- sub addServer {
- my $self = shift;
- push(@{$self->_servers}, @_);
- foreach (@_) {
- $_->setParent($self);
- }
- }
- sub removeServer {
- my $self = shift;
- my $server = shift;
- for(my $i = 0; $i < @{$self->_servers}; $i++) {
- splice(@{$self->_servers}, $i, 1) if($self->_servers->[$i] == $server);
- }
- }
-
- sub getSockets {
- my $self = shift;
- my @sockets = $self->SUPER::getSockets;
- foreach($self->getServers) {
- push(@sockets, $_->getSockets);
- }
- return(@sockets);
- }
-
- sub destroySelf {
- my $self = shift;
- $self->getParent->removeListener($self);
- $self->SUPER::destroySelf;
- }
-
- sub isListener {
- return(1);
- }
-
- ##### #####
- ## server ##
- ##### #####
- package sN::server;
- use base 'sN::socketBase';
-
- sub new {
- my $class = shift;
- my $glob = $class->SUPER::new(@_);
- return if(!$glob);
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'attachedListeners'} = [];
- $self->{__PACKAGE__.'bufferedData'} = '';
- return($glob);
- }
-
- sub _attachedListeners {
- my $glob = shift;
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'attachedListeners'} = shift if(@_);
- return($self->{__PACKAGE__.'attachedListeners'});
- }
-
- sub _bufferedData {
- my $glob = shift;
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'bufferedData'} = shift if(@_);
- return($self->{__PACKAGE__.'bufferedData'});
- }
-
- sub getAttachedListeners {
- my $self = shift;
- return(@{$self->_attachedListeners});
- }
- sub addAttachedListener {
- my $self = shift;
- push(@{$self->_attachedListeners}, @_);
- foreach (@_) {
- $_->setParent($self);
- }
- }
- sub removeAttachedListener {
- my $self = shift;
- my $attachedListener = shift;
- for(my $i = 0; $i < @{$self->_attachedListeners}; $i++) {
- splice(@{$self->_attachedListeners}, $i, 1) if($self->_attachedListeners->[$i] == $attachedListener);
- }
- }
-
- sub getClients {
- my $self = shift;
- my @clients;
- foreach ($self->getAttachedListeners) {
- push(@clients, $_->getClients);
- }
- return(@clients);
- }
-
- # Until I implement something with multiple servers, this will just tear down the object.
- #fixme Need to figure this out more
- sub removeServer {
- my $self = shift;
- $self->getParent->removeServer($self);
- $self->shutdown(2);
- }
-
- sub bufferData {
- my $self = shift;
- my $data = shift;
- $self->_bufferedData($self->_bufferedData . $data);
- }
-
- sub flushBuffer {
- my $self = shift;
- if($self->getClients && defined($self->_bufferedData)) {
- $self->writeClients($self->_bufferedData);
- $self->_bufferedData('');
- }
- }
-
- ###
- # Write'ers
- ###
- sub serverWrite {
- my $self = shift;
- my $data = shift;
- if($self->getClients == 0) {
- #fixme print "No clients, buffering data\n" if($main::superDebug);
- #fixme print "Buffering data.\n";
- $self->bufferData($data);
- }
- else {
- #fixme print "Writing out data.\n" if($main::superDebug);
- $self->writeClients($data);
- }
- }
- sub clientWrite {
- my $self = shift;
- my $except = shift;
- my $data = shift;
- $self->writeServers($data);
- $self->writeClientsExcept($except, $data);
- }
- sub writeServers {
- my $self = shift;
- my $data = shift;
- $self->send($data);
- }
- sub writeClients {
- my $self = shift;
- my $data = shift;
- foreach my $client ($self->getClients) {
- $client->send($data);
- }
- }
- sub writeClientsExcept {
- my $self = shift;
- my $except = shift;
- my $data = shift;
- foreach my $listener ($self->getAttachedListeners) {
- foreach my $client ($listener->getClients) {
- next if($client == $except);
- $client->send($data);
- }
- }
- }
-
- sub getSockets {
- my $self = shift;
- my @sockets = $self->SUPER::getSockets;
- foreach($self->getAttachedListeners) {
- push(@sockets, $_->getSockets);
- }
- return(@sockets);
- }
- sub destroySelf {
- my $self = shift;
- $self->getParent->removeServer($self);
- $self->SUPER::destroySelf;
- }
- sub isServer {
- return(1);
- }
-
-
- ##### #####
- ## attachedListener ##
- ##### #####
- package sN::attachedListener;
- use base 'sN::socketBase';
-
- sub new {
- my $class = shift;
- my $glob = $class->SUPER::new(@_);
- return if(!$glob);
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'clients'} = [];
- return($glob);
- }
-
- sub _clients {
- my $glob = shift;
- my $self = *{$glob}{HASH};
- $self->{__PACKAGE__.'clients'} = shift if(@_);
- return($self->{__PACKAGE__.'clients'});
- }
-
- sub getClients {
- my $self = shift;
- return(@{$self->_clients});
- }
- sub addClient {
- my $self = shift;
- push(@{$self->_clients}, @_);
- foreach (@_) {
- $_->setParent($self);
- }
- $self->getParent->flushBuffer;
- }
- sub removeClient {
- my $self = shift;
- my $client = shift;
- for(my $i = 0; $i < @{$self->_clients}; $i++) {
- splice(@{$self->_clients}, $i, 1) if($self->_clients->[$i] == $client);
- }
- }
-
-
- sub getSockets {
- my $self = shift;
- my @sockets = $self->SUPER::getSockets;
- foreach($self->getClients) {
- push(@sockets, $_->getSockets);
- }
- return(@sockets);
- }
- sub destroySelf {
- my $self = shift;
- $self->getParent->removeAttachedListener($self);
- $self->SUPER::destroySelf;
- }
-
- sub isAttachedListener {
- return(1);
- }
-
-
- ##### #####
- ## client ##
- ##### #####
- package sN::client;
- use base 'sN::socketBase';
-
- sub destroySelf {
- my $self = shift;
- $self->getParent->removeClient($self);
- $self->SUPER::destroySelf;
- }
-
- sub isClient {
- return(1);
- }
-
-
- ##### #####
- ## Col Print ##
- ##### #####
- package sN::colprint;
- use strict;
-
- sub new {
- return(bless(
- {
- __PACKAGE__.'data' => [],
- __PACKAGE__.'maxLen' => [],
- __PACKAGE__.'initIndent' => $_[1] || 0,
- __PACKAGE__.'pad' => $_[2] || 2,
- }, shift)
- );
- }
-
- ###
- # Internals
- ###
- sub _data {
- my $self = shift;
- $self->{__PACKAGE__.'data'} = shift if(@_);
- return($self->{__PACKAGE__.'data'});
- }
- sub _maxLen {
- my $self = shift;
- $self->{__PACKAGE__.'maxLen'} = shift if(@_);
- return($self->{__PACKAGE__.'maxLen'});
- }
- sub _initIndent {
- my $self = shift;
- $self->{__PACKAGE__.'initIndent'} = shift if(@_);
- return($self->{__PACKAGE__.'initIndent'});
- }
- sub _pad {
- my $self = shift;
- $self->{__PACKAGE__.'pad'} = shift if(@_);
- return($self->{__PACKAGE__.'pad'});
- }
-
-
- ###
- # Add'ers
- ###
- sub addRow {
- my $self = shift;
- my $maxLen = $self->_maxLen;
- push(@{$self->_data}, [ @_ ]);
- for(my $i = 0; $i < @_; $i++) {
- $maxLen->[$i] = length($_[$i]) if(length($_[$i]) > $maxLen->[$i]);
- }
- }
-
- ###
- # Get'ers
- ###
- sub getOutput {
- my $self = shift;
- my $output;
- foreach (@{$self->_data}) {
- $output .= " " x ($self->_pad * $self->_initIndent);
- for(my $i = 0; $i < @{$_}; $i++) {
- my $cell = $_->[$i];
- if($cell eq '__hr__') {
- $output .= "-" x $self->_maxLen->[$i] . " " x $self->_pad;
- next;
- }
- $output .= $cell . " " x ($self->_maxLen->[$i] - length($cell) + $self->_pad);
- }
- $output .= "\n";
- }
- return($output);
- }
-